home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue61 / Actions / TabActns.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-05-26  |  3.0 KB  |  115 lines
  1. unit TabActns;
  2.  
  3. interface
  4.  
  5. uses
  6.   ActnList, Classes, ComCtrls;
  7.  
  8. type
  9.   TTabAction = class(TAction)
  10.   private
  11.     FTabControl: TCustomTabControl;
  12.   protected
  13.     procedure SetTabControl(Value: TCustomTabControl);
  14.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  15.   public
  16.     function HandlesTarget(Target: TObject): Boolean; override;
  17.     procedure UpdateTarget(Target: TObject); override;
  18.   published
  19.     property TabControl: TCustomTabControl read FTabControl write SetTabControl;
  20.   end;
  21.  
  22.   TNextTabAction = class(TTabAction)
  23.   public
  24.     procedure ExecuteTarget(Target: TObject); override;
  25.   end;
  26.  
  27.   TPriorTabAction = class(TTabAction)
  28.   public
  29.     procedure ExecuteTarget(Target: TObject); override;
  30.   end;
  31.  
  32. implementation
  33.  
  34. { TTabAction }
  35.  
  36. procedure TTabAction.SetTabControl(Value: TCustomTabControl);
  37. begin
  38.   if Value <> FTabControl then
  39.   begin
  40.     FTabControl := Value;
  41.     //If we have a target control, request notification
  42.     //so we will be told if it is destroyed
  43.     if Assigned(Value) then
  44.       Value.FreeNotification(Self)
  45.   end;
  46. end;
  47.  
  48. procedure TTabAction.Notification(AComponent: TComponent;
  49.   Operation: TOperation);
  50. begin
  51.   //Set target control property to nil if target is destroyed
  52.   if (AComponent = FTabControl) and (Operation = opRemove) then
  53.     FTabControl := nil
  54. end;
  55.  
  56. function TTabAction.HandlesTarget(Target: TObject): Boolean;
  57. begin
  58.   //If we have a specific target and it matches
  59.   //the passed control, we will accept it
  60.   if Target = FTabControl then
  61.     Result := True
  62.   else
  63.     //If we have no specific target, but the passed
  64.     //control is of an acceptable type, then we accept it
  65.     if (FTabControl = nil) and
  66.        ((Target is TTabControl) or
  67.         (Target is TPageControl)) then
  68.       Result := True
  69.     else
  70.       Result := False;
  71. end;
  72.  
  73. procedure TTabAction.UpdateTarget(Target: TObject);
  74. begin
  75.   //Make sure tab control has more than one tab
  76.   if Target is TTabControl then
  77.     Enabled := TTabControl(Target).Tabs.Count > 1
  78.   else
  79.     //Make sure page control has more than one page
  80.     if Target is TPageControl then
  81.       Enabled := TPageControl(Target).PageCount > 1
  82.     else
  83.       //No other TCustomTabControl derivative is understood
  84.       Enabled := False;
  85. end;
  86.  
  87. { TPriorTabAction }
  88.  
  89. procedure TPriorTabAction.ExecuteTarget(Target: TObject);
  90. begin
  91.   if Target is TTabControl then
  92.     with TTabControl(Target) do
  93.       TabIndex := (TabIndex - 1 + Tabs.Count) mod Tabs.Count
  94.   else
  95.     if Target is TPageControl then
  96.       with TPageControl(Target) do
  97.         ActivePage :=
  98.           Pages[(ActivePage.TabIndex - 1 + PageCount) mod PageCount]
  99. end;
  100.  
  101. { TNextTabAction }
  102.  
  103. procedure TNextTabAction.ExecuteTarget(Target: TObject);
  104. begin
  105.   if Target is TTabControl then
  106.     with TTabControl(Target) do
  107.       TabIndex := (TabIndex + 1) mod Tabs.Count
  108.   else
  109.     if Target is TPageControl then
  110.       with TPageControl(Target) do
  111.         ActivePage := Pages[(ActivePage.TabIndex + 1) mod PageCount]
  112. end;
  113.  
  114. end.
  115.